home *** CD-ROM | disk | FTP | other *** search
/ Monster Media 1996 #14 / Monster Media No. 14 (April 1996) (Monster Media, Inc.).ISO / pcboard / nodesrch.zip / NODESRCH.PPE (.txt) < prev   
PCBoard Programming Language Executable  |  1996-02-03  |  6KB  |  448 lines
  1. ;------------------------------------------------------------------------------
  2. ;                                                   .ss.
  3. ;                                                   `²²'
  4. ;             .,sS$Ss,,s$  .,sS$$$Ss.  .,sS$Ss,,s$ .ss.  .sSs.
  5. ;           .d$$²^°²$$$$'.d$P²°^^²$P'.d$$²^°²$$$$'.$$$' .$$$²Sb,.
  6. ;           $$$'   .$$$' $$$²Sçsµ²' .$$$'   .$$$'.$$$' .$$$'  `$$b.
  7. ;           $$$b,,d$$$' ,$$$b,....,s$$$$b,,d$$$'.$$$;.,$$$'    ;$$$
  8. ;           `²S$$S²²S$$S²°²S$$$$S²°°²S$$$$$$',$$S²°²S$S'.sS$$$P²'
  9. ;                                    .sS²°$$$²²°"'       d²°'
  10. ;                                  .$$²  .$$'
  11. ;                                  $$$.,d$$'
  12. ;                                  `²S$$S²'
  13. ;------------------------------------------------------------------------------
  14. ; P.P.L.X. 2.OO                          (C)1996 - Lone Runner / AEGiS CoRP'96 
  15. ;------------------------------------------------------------------------------
  16. ; PPE 3.2O (Encryption type I) - Analysis ON - Postprocessing ON
  17. ;------------------------------------------------------------------------------
  18.  
  19.     Integer  INTEGER001
  20.     Integer  INTEGER002
  21.     Integer  INTEGER003
  22.     Integer  INTEGER004
  23.     Integer  INTEGER005
  24.     Integer  INTEGER006
  25.     String   STRING001
  26.     String   STRING002
  27.     String   STRING003
  28.     String   STRING004
  29.     String   STRING005
  30.     String   STRING006
  31.     String   STRING007
  32.     String   STRING008
  33.     String   STRING009
  34.     String   STRING010
  35.     String   STRING011
  36.     String   STRING012
  37.     String   STRING013
  38.     String   STRING014
  39.     String   STRING015
  40.     String   STRING016
  41.     String   STRING017
  42.     String   STRING018
  43.     Declare  Function FUNCTION001() String
  44.     Declare  Procedure PROC001()
  45.     Declare  Procedure PROC002()
  46.     Declare  Procedure PROC003()
  47.     Declare  Procedure PROC004()
  48.     Declare  Procedure PROC005()
  49.     Declare  Procedure PROC006()
  50.  
  51. ;------------------------------------------------------------------------------
  52.  
  53.     PROC006()
  54.     INTEGER001 = DNext()
  55.     STRING001 = " "
  56.     Cls
  57.     PROC003()
  58.     While (Upper(STRING001) <> "Q") Do
  59.         STRING001 = FUNCTION001()
  60.         Select Case (STRING001)
  61.             Case "r", "R"
  62.                 Cls
  63.                 DCloseAll
  64.                 If (Exist(PPEPath() + "nodelist.dbf")) Then
  65.                     DOpen INTEGER001, PPEPath() + "nodelist", 0
  66.                     If (DErr(INTEGER001)) Goto LABEL001
  67.                     PrintLn 
  68.                     PrintLn "File Opened"
  69.                     PrintLn "creating index..."
  70.                     PROC001()
  71.                     Goto LABEL002
  72.                     :LABEL001
  73.                     PrintLn 
  74.                     PrintLn "Error opening file"
  75.                     :LABEL002
  76.                     Wait
  77.                 Else
  78.                     PrintLn 
  79.                     PrintLn "File does not exist"
  80.                     Wait
  81.                 Endif
  82.             Case "s", "S"
  83.                 Cls
  84.                 DCloseAll
  85.                 If (Exist(PPEPath() + "nodelist.dbf")) Then
  86.                     DOpen INTEGER001, PPEPath() + "nodelist", 0
  87.                     If (DErr(INTEGER001)) Goto LABEL003
  88.                     PrintLn 
  89.                     PrintLn "File Opened"
  90.                     Goto LABEL004
  91.                     :LABEL003
  92.                     PrintLn 
  93.                     PrintLn "Error opening file"
  94.                     :LABEL004
  95.                     If (Exist(PPEPath() + "nodesrch.ndx")) Then
  96.                         DnOpen INTEGER001, PPEPath() + "nodesrch.ndx"
  97.                         DTag INTEGER001, "nodesrch"
  98.                     Endif
  99.                 Else
  100.                     PrintLn 
  101.                     PrintLn "File does not exist"
  102.                     Wait
  103.                 Endif
  104.                 PROC002()
  105.             Case "q", "Q"
  106.                 End
  107.         End Select
  108.         Cls
  109.         PROC003()
  110.     EndWhile
  111.     End
  112.  
  113. ;------------------------------------------------------------------------------
  114.  
  115.     Procedure PROC006()
  116.  
  117.     String   STRING005
  118.     String   STRING006
  119.     String   STRING007
  120.     String   STRING008
  121.     String   STRING009
  122.     Integer  INTEGER002
  123.     Integer  INTEGER003
  124.     Integer  INTEGER004
  125.  
  126.     If (Exist(PPEPath() + "NODESRCH.CFG")) Then
  127.         FOpen 1, PPEPath() + "NODESRCH.CFG", 2, 0 + 0
  128.         If (Ferr(1)) Goto LABEL005
  129.         PrintLn 
  130.         PrintLn ".CFG File Found!"
  131.         Goto LABEL006
  132.         :LABEL005
  133.         PrintLn 
  134.         PrintLn "  Nodesrch.cfg Not Found"
  135.         PrintLn "  Please see the DOCs"
  136.         End
  137.     Endif
  138.     :LABEL006
  139.     FGet 1, STRING006
  140.     FGet 1, STRING008
  141.     FClose 1
  142.     STRING009 = Strip(STRING006, " ")
  143.     For INTEGER004 = 1 To Len(STRING009)
  144.         STRING007 = Mid(STRING009, INTEGER004, 1)
  145.         INTEGER002 = Asc(STRING007)
  146.         INTEGER003 = INTEGER003 + INTEGER002
  147.     Next
  148.     STRING005 = (INTEGER003 * Len(STRING009)) * 13
  149.     PrintLn "regnum = ", STRING005
  150.     PrintLn "rkey = ", STRING008
  151.     If (STRING008 == STRING005) Then
  152.         PrintLn 
  153.         PrintLn 
  154.         PrintLn "               This PPE is Registered to ", STRING006
  155.     Else
  156.         PrintLn 
  157.         PrintLn "               This PPE is unregistered!!!!"
  158.     Endif
  159.     Wait
  160.  
  161.     EndProc
  162.  
  163.  
  164. ;------------------------------------------------------------------------------
  165.  
  166.     Procedure PROC001()
  167.  
  168.     If (Exist(PPEPath() + "nodesrch.ndx")) Delete PPEPath() + "nodesrch.ndx"
  169.     DnCreate INTEGER001, PPEPath() + "nodesrch.ndx", "Sysop_Name"
  170.     If (DErr(INTEGER001)) Then
  171.         PrintLn "Error creating index."
  172.         Wait
  173.         Return
  174.     Endif
  175.     DTag INTEGER001, "nodesrch"
  176.     If (DErr(INTEGER001)) Goto LABEL007
  177.     PrintLn "Index created."
  178.     PrintLn "The key field is ", DName(INTEGER001, 6)
  179.     Goto LABEL008
  180.     :LABEL007
  181.     PrintLn "Error creating index..."
  182.     :LABEL008
  183.  
  184.     EndProc
  185.  
  186.  
  187. ;------------------------------------------------------------------------------
  188.  
  189.     Procedure PROC002()
  190.  
  191.     String   STRING010
  192.     String   STRING011
  193.     String   STRING012
  194.     String   STRING013
  195.     Integer  INTEGER005
  196.  
  197.     PrintLn "@X02Search on @X0D", DName(INTEGER001, 6), " @X02field,"
  198.     PrintLn 
  199.     Input "@X05Enter the name to search for: _", STRING010
  200.     PrintLn 
  201.     PrintLn "@X02Searching for@X04 ", Mixed(STRING010), "@X02 in field ", DName(INTEGER001, 6), " ..."
  202.     DSeek INTEGER001, Mixed(STRING010)
  203.     If (DChkStat(INTEGER001) == 0) Then
  204.         PrintLn "@X09Record Number @X0F", DRecNo(INTEGER001), "@X07"
  205.         INTEGER005 = 6
  206.         DGet INTEGER001, DName(INTEGER001, INTEGER005), STRING011
  207.         Print "@X0A", Trim(STRING011, " "), "@X0F"
  208.         INTEGER005 = 1
  209.         DGet INTEGER001, DName(INTEGER001, INTEGER005), STRING011
  210.         Print "     @X0A", Trim(STRING011, " "), ":", "@X0F"
  211.         INTEGER005 = 2
  212.         DGet INTEGER001, DName(INTEGER001, INTEGER005), STRING011
  213.         Print "@X0A", Trim(STRING011, " "), "/", "@X0F"
  214.         INTEGER005 = 3
  215.         DGet INTEGER001, DName(INTEGER001, INTEGER005), STRING011
  216.         Print "@X0A", Trim(STRING011, " "), "@X0F"
  217.         INTEGER005 = 4
  218.         DGet INTEGER001, DName(INTEGER001, INTEGER005), STRING011
  219.         Print "     @X0A", Trim(STRING011, " "), "@X0F"
  220.         PrintLn 
  221.         PrintLn 
  222.         Input "Is this the right one? Y/N/Q _", STRING012
  223.         PrintLn 
  224.         Select Case (Upper(STRING012))
  225.             Case "Y"
  226.                 Cls
  227.                 PrintLn 
  228.                 PrintLn "Ok Thanks ", U_Name()
  229.                 PROC004()
  230.             Case "N"
  231.                 PrintLn 
  232.                 PrintLn "OK we will try again"
  233.                 Gosub LABEL009
  234.             Case "Q"
  235.                 PrintLn 
  236.                 PrintLn "Thank you for using Node Search"
  237.         End Select
  238.     Else
  239.         PrintLn 
  240.         PrintLn STRING010, " not found!"
  241.         Wait
  242.     Endif
  243.     :LABEL009
  244.     STRING013 = DGet(INTEGER001, "Sysop_Name")
  245.     STRING010 = STRING013
  246.     While (STRING013 == STRING010) Do
  247.         DSkip INTEGER001, 1
  248.         STRING013 = DGet(INTEGER001, "Sysop_Name")
  249.         PrintLn "@X09Record Number @X0F", DRecNo(INTEGER001), "@X07"
  250.         INTEGER005 = 6
  251.         DGet INTEGER001, DName(INTEGER001, INTEGER005), STRING011
  252.         Print "@X0A", Trim(STRING011, " "), "@X0F"
  253.         INTEGER005 = 1
  254.         DGet INTEGER001, DName(INTEGER001, INTEGER005), STRING011
  255.         Print "     @X0A", Trim(STRING011, " "), ":", "@X0F"
  256.         INTEGER005 = 2
  257.         DGet INTEGER001, DName(INTEGER001, INTEGER005), STRING011
  258.         Print "@X0A", Trim(STRING011, " "), "/", "@X0F"
  259.         INTEGER005 = 3
  260.         DGet INTEGER001, DName(INTEGER001, INTEGER005), STRING011
  261.         Print "@X0A", Trim(STRING011, " "), "@X0F"
  262.         INTEGER005 = 4
  263.         DGet INTEGER001, DName(INTEGER001, INTEGER005), STRING011
  264.         Print "     @X0A", Trim(STRING011, " "), "@X0F"
  265.         PrintLn 
  266.         PrintLn 
  267.         Input "Is this the right one? Y/N _", STRING002
  268.         If (Upper(STRING002) == "Y") Then
  269.             PROC004()
  270.             Return
  271.             Goto LABEL010
  272.         Endif
  273.         :LABEL010
  274.         PrintLn 
  275.     EndWhile
  276.     Return
  277.  
  278.     EndProc
  279.  
  280.  
  281. ;------------------------------------------------------------------------------
  282.  
  283.     Procedure PROC004()
  284.  
  285.     Integer  INTEGER006
  286.     String   STRING014
  287.     String   STRING015
  288.     String   STRING016
  289.     String   STRING017
  290.  
  291.     Cls
  292.     PrintLn "@X09Record Number @X0F", DRecNo(INTEGER001), "@X07"
  293.     INTEGER006 = 6
  294.     DGet INTEGER001, DName(INTEGER001, INTEGER006), STRING003
  295.     Print "@X0A", Trim(STRING003, " "), "@", "@X0F"
  296.     STRING014 = Trim(STRING003, " ") + "@"
  297.     INTEGER006 = 1
  298.     DGet INTEGER001, DName(INTEGER001, INTEGER006), STRING003
  299.     Print "@X0A", Trim(STRING003, " "), ":", "@X0F"
  300.     STRING015 = Trim(STRING003, " ") + ":"
  301.     INTEGER006 = 2
  302.     DGet INTEGER001, DName(INTEGER001, INTEGER006), STRING003
  303.     Print "@X0A", Trim(STRING003, " "), "/", "@X0F"
  304.     STRING016 = Trim(STRING003, " ") + "/"
  305.     INTEGER006 = 3
  306.     DGet INTEGER001, DName(INTEGER001, INTEGER006), STRING003
  307.     Print "@X0A", Trim(STRING003, " "), "@X0F"
  308.     STRING017 = Trim(STRING003, " ")
  309.     STRING004 = STRING014 + STRING015 + STRING016 + STRING017
  310.     PROC005()
  311.  
  312.     EndProc
  313.  
  314.  
  315. ;------------------------------------------------------------------------------
  316.  
  317.     Procedure PROC005()
  318.  
  319.     Cls
  320.     KbdStuff STRING004
  321.     Command 0, "E"
  322.  
  323.     EndProc
  324.  
  325.  
  326. ;------------------------------------------------------------------------------
  327.  
  328.     Procedure PROC003()
  329.  
  330.     PrintLn 
  331.     PrintLn 
  332.     PrintLn 
  333.     PrintLn 
  334.     PrintLn 
  335.     PrintLn "               @X0A┌─────────────────────────────────────────────┐     "
  336.     PrintLn "     @X0A          │                                             │     "
  337.     PrintLn "     @X0A          │              @X04NODE SEARCH v 1.O@X0A              │     "
  338.     PrintLn "     @X0A          │                                             │     "
  339.     PrintLn "     @X0A          │        @X0ER@X09ecompile the index.@X0A                 │     "
  340.     PrintLn "     @X0A          │        @X0ES@X09earch the nodelist.@X0A                 │     "
  341.     PrintLn "     @X0A          │                                             │     "
  342.     PrintLn "     @X0A          │        @X0EQ@X09uit and return to the BBS.@X0A          │     "
  343.     PrintLn "     @X0A          │                                             │     "
  344.     PrintLn "     @X0A          │                  @X0ER@X0F/@X0ES@X0F/@X0EQ @X8F?@X0A                    │     "
  345.     PrintLn "     @X0A          └─────────────────────────────────────────────┘     "
  346.     PrintLn 
  347.     PrintLn 
  348.     PrintLn 
  349.     PrintLn 
  350.     PrintLn "@X0F"
  351.  
  352.     EndProc
  353.  
  354.  
  355. ;------------------------------------------------------------------------------
  356.  
  357.     Function FUNCTION001() String
  358.  
  359.     While (FUNCTION001 == "") Do
  360.         FUNCTION001 = Inkey()
  361.     EndWhile
  362.  
  363.     EndFunc
  364.  
  365.  
  366. ;------------------------------------------------------------------------------
  367. ;
  368. ; Usage report (before postprocessing)
  369. ;
  370. ; ■ Statements used :
  371. ;
  372. ;    3       End
  373. ;    7       Cls
  374. ;    6       Wait
  375. ;    40      Goto 
  376. ;    33      Let 
  377. ;    14      Print 
  378. ;    71      PrintLn 
  379. ;    23      If 
  380. ;    3       Input 
  381. ;    1       FOpen 
  382. ;    1       FClose 
  383. ;    2       FGet 
  384. ;    1       Delete 
  385. ;    1       Gosub 
  386. ;    3       Return
  387. ;    1       KbdStuff 
  388. ;    6       EndProc
  389. ;    1       EndFunc
  390. ;    2       DOpen 
  391. ;    2       DCloseAll
  392. ;    1       DnCreate 
  393. ;    1       DnOpen 
  394. ;    1       DSkip 
  395. ;    2       DTag 
  396. ;    1       DSeek 
  397. ;    14      DGet 
  398. ;    1       Command 
  399. ;
  400. ;
  401. ; ■ Functions used :
  402. ;
  403. ;    2       *
  404. ;    20      +
  405. ;    14      ==
  406. ;    1       <>
  407. ;    1       <
  408. ;    1       <=
  409. ;    2       >=
  410. ;    22      !
  411. ;    2       &&
  412. ;    4       ||
  413. ;    3       Len(
  414. ;    5       Upper()
  415. ;    1       Mid()
  416. ;    1       Ferr()
  417. ;    1       Asc()
  418. ;    18      Trim()
  419. ;    1       U_Name()
  420. ;    1       Strip()
  421. ;    1       Inkey()
  422. ;    11      PPEPath()
  423. ;    5       Exist()
  424. ;    2       Mixed()
  425. ;    4       DErr()
  426. ;    17      DName()
  427. ;    3       DRecNo()
  428. ;    1       DNext()
  429. ;    2       DGet()
  430. ;    1       DChkStat()
  431. ;
  432. ;------------------------------------------------------------------------------
  433. ;
  434. ; Analysis flags : No flag
  435. ;
  436. ;------------------------------------------------------------------------------
  437. ;
  438. ; Postprocessing report
  439. ;
  440. ;    1       For/Next
  441. ;    3       While/EndWhile
  442. ;    8       If/Then or If/Then/Else
  443. ;    2       Select Case
  444. ;
  445. ;------------------------------------------------------------------------------
  446. ;                 AEGiS Corp - Break the routines, code against the machines!
  447. ;------------------------------------------------------------------------------
  448.